gusucode.com > 耐品图片管理系统 标准版A > 耐品图片管理系统 标准版A/Inc/clsMain.asp

    <%
'===============================================================
' 著作权号：中国国家版权局著作权登记号2004SR07385
' 版权所有：深圳市耐品科技开发有限公司 www.naipin.com
' 联系电话：0755-26611119　81234844　81234845
' 联系手机：13316911914
' 联系邮箱：naipin@naipin.com
'===============================================================

' ======================系统公共类==============================
' FileName: clsMain.asp
' DateTime: 2006-05-18
' Copyright (C) 2006-2007 www.naipin.com
' Script Written By Lyout
' Last Modified: 2006-09-04
'===============================================================

Class Netout_Photo
	' 分页变量
	Public MaxPerPage
	Public TopPage
	Public BottomPage
	Public SqlRecord
	Public InitText
	Public strFileName
	
	' 系统变量
	Public Master				' 是否为管理员
	Public Photoer				' 是否为摄影师
	
	' 公共模板变量
	Public TempHtml				' 页面公共模板(输出)
	Public CommHtml				' 公共模板(数组，页面公共部分)
	Public MainPage				' 公共页面框架（数组）
	Public StyleId				' 当前风格Id
	Public CssFilePath			' 当前风格图片文件路径（相对于Face/）
	Public CssFileName			' 当前风格Css文件名
	Public ErrCode
	Public TheCode
	
	' 当前用户信息
	Public UserTrueIP			' 用户真实IP
	Public UserId				' 用户Id
	Public UserName				' 用户名
	Public UserGroupId			' 用户所属组Id
	Public UserGroupName		' 用户所属组名称
	
	Private theCacheName

	Private Sub Class_Initialize()
		UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR")
		
		LoadStyle()
		
		InitCookies()
	End Sub
	Private Sub Class_Terminate
		If Not Conn Is Nothing Then
			If IsObject(Conn) Then Conn.Close()
			Set Conn = Nothing
		End If
	End Sub
	
	Public Sub SetCookie(key,value)
		Response.Cookies(CookieName)(key) = value
	End Sub
	
	Public Function GetCookie(key)
		GetCookie = Trim(Request.Cookies(CookieName)(key)&"")
	End Function
	
	Public Sub SetPurview(Setting)
		Dim Purview
		Purview = Split(Setting&",,,,,,,,,,",",")
		
		SetCookie "Setting",		Trim(Setting&"")
		SetCookie "View",			Purview(0) 	'浏览图片
		SetCookie "ViewHide",		Purview(1) 	'浏览隐藏图片
		SetCookie "Vote",			Purview(2)	'评论评分
		SetCookie "Upload",			Purview(3)	'上传图片
		SetCookie "PicFlag",		Purview(4)	'图片不需要审核
		SetCookie "Self",			Purview(5)	'管理自己图片
		SetCookie "Manage",			Purview(6)	'管理所有图片
		SetCookie "Article",		Purview(7)	'发表文章
		SetCookie "ArticleFlag",	Purview(8)	'文章不需要审核
		SetCookie "Comment",		Purview(9)	'文章评论权限
		SetCookie "Source",			Purview(10)	'查看原图
	End Sub
	
	Public Sub InitCookies()
		Master = False
		Photoer = False
		
		If GetCookie("UserName")="" then
			Dim Rs
			Set Rs = Conn.Execute("select Setting,GroupName from NT_UserGroup where ID=5")
			
			SetPurview Rs("Setting")
			SetCookie "GroupID",		5
			SetCookie "Group",			rs("GroupName")
			
			UserId = "0"
			UserName = ""
			Set Rs = Nothing
		Else
			UserId = GetCookie("UserId")
			UserName = GetCookie("UserName")
		End If
		
		UserGroupId = GetCookie("GroupID")
		UserGroupName = GetCookie("Group")
		
		If UserGroupId="1" Then
			Master = True
		ElseIf UserGroupId="2" Then
			Photoer = True
		End If
	End Sub

	Public Property Let Cache(ByVal vNewValue)
		theCacheName = vNewValue
	End Property
	Public Property Let vCache(ByVal vNewValue)
		Application.Lock()
		Config.SetCache theCacheName,vNewValue
		Application.UnLock() 
	End Property
	Public Property Get vCache()
		vCache = Config.GetCache(theCacheName)
	End Property
	Public Function CacheIsEmpty()
		Dim oCacheData
		CacheIsEmpty = True	
		oCacheData = Config.GetCache(theCacheName)
		If IsNull(oCacheData) or IsEmpty(oCacheData) or oCacheData="" Then Exit Function
		CacheIsEmpty = False
	End Function
	Public Sub DelCache(MyCacheName)
		Application.Lock()
		Application.Contents.Remove(Config.CacheName&"_"&MyCacheName)
		Application.UnLock()
	End Sub
	Public Sub EmptyCaches()
		Application.Lock()
		Application.Contents.RemoveAll()
		Application.UnLock()
	End Sub
	
	Public Sub LoadStyle()
		StyleId = CheckNumeric(Trim(Request.Cookies(CookieName)("StyleId")&""))
		If StyleId = 0 Then StyleId = Config.SiteStyle

		Cache = "StyleCss"
		If CacheIsEmpty() Then
			TempToCache("StyleCss")
			Set Application(Config.CacheName & "_csslist")=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
			Application(Config.CacheName&"_csslist").LoadXML vCache
		End If
		
		Dim Css
		Set Css = Application(Config.CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& StyleId &"']")
		If Not Css  Is Nothing Then
			CssFileName = Css.getAttribute("filename")
			CssFilePath = Css.getAttribute("filepath")
		End If
		
		If Not Purchase Is Nothing Then
			Purchase.ImagePath = CssFilePath
		End If
	End Sub
	
	Public Function GetStyleMenu()
		Dim Css,node,StyleMenu,i
		Set Css = Application(Config.CacheName & "_csslist").documentElement.selectNodes("css")
		If Css.Length>0 Then
			i = 1
			For Each node In Css
				If i = Css.Length Then StyleMenu = StyleMenu & "└" Else StyleMenu = StyleMenu & "├"
				StyleMenu = StyleMenu & "<a href='SetCookie.asp?StyleId="&node.getAttribute("id")&"'>"&node.getAttribute("type")&"</a><br>"
				i = i+1
			Next
		End If
		GetStyleMenu = StyleMenu
	End Function

	Public Sub Load(CurrentScript)
		Dim InfoCode,MyBannerImage
		
		Cache = "CommHtml"
		If CacheIsEmpty() Then TempToCache("CommHtml")
		CommHtml = Replace(vCache,"{?PicUrl}",CssFilePath)
		CommHtml = Split(Replace(CommHtml,"{?ClassOption}",ClassOption("ClassID",0)),"@@")
		
		TopSearch = Replace(CommHtml(0),"{?UserLoginInfo}",UserLogin())
		
		Cache = "InfoCode"
		If CacheIsEmpty() Then TempToCache("InfoCode")
		InfoCode = Split(vCache,"@@")
		ErrCode = Split(InfoCode(0),"||")
		theCode = Split(InfoCode(1),"||")
		
		Cache = "MainPage"
		If CacheIsEmpty() Then TempToCache("MainPage")
		
		MainPage = Replace(Replace(vCache,"{?StyleMenu}",GetStyleMenu()),"{?StyleCss}",CssFileName)
		MainPage = Replace(Replace(MainPage,"{?PicUrl}",CssFilePath),"{?SiteTitle}",Config.SiteTitle)
		MainPage = Replace(Replace(MainPage,"{?SiteName}",Config.SiteName),"{?SiteUrl}",Config.SiteUrl)
		MainPage = Replace(Replace(MainPage,"{?SiteEmail}",Config.UserEmail(0)),"{?MenuJS}",CommHtml(8))
		MainPage = Replace(Replace(MainPage,"{?Keyword}",Config.SiteKeys),"{?Description}",Config.SiteDesc)
		MainPage = Replace(Replace(MainPage,"{?Version}",Config.SoftInfo(1)),"{?TopLink}",GetTopLink(1000))
		
		If Config.UserEmail(1) = "1" Then
			MainPage = Replace(MainPage,"{?UserEmail}","邮箱:<a href='mailto:"&Config.UserEmail(0)&"'>"&Replace(Config.UserEmail(0),"@","<img src='Face/"&CssFilePath&"/at.gif' align=absmiddle border=0>")&"</a>")
		Else
			MainPage = Replace(MainPage,"{?UserEmail}","")
		End If
		If Config.UserPhone(2) = "1" Then
			MainPage = Replace(MainPage,"{?UserPhone}","电话："&Config.UserPhone(0)&"-"&Config.UserPhone(1))
		Else
			MainPage = Replace(MainPage,"{?UserPhone}","")
		End If
		If Config.UserPhone(4) = "1" Then
			MainPage = Replace(MainPage,"{?UserMobile}","手机："&Config.UserPhone(3))
		Else
			MainPage = Replace(MainPage,"{?UserMobile}","")
		End If
		If Config.UserAdd(5) = "1" Then
			MainPage = Replace(MainPage,"{?UserAdd}","地址："&Config.UserAdd(0)&Config.UserAdd(4))
		Else
			MainPage = Replace(MainPage,"{?UserAdd}","")
		End If
		MainPage = Replace(Replace(MainPage,"{?SiteNumber}",Config.SiteNumber),"{?SiteLang}",Config.SiteLang)
		MainPage = Replace(MainPage,"{?PoweredBy}","<a href='"&Config.SoftInfo(2)&"' target='_blank'>"&Config.SoftInfo(3)&"</a>")
		
		MainPage = Split(MainPage,"@@")
		
		If Not Master Then
			If Not Purchase Is Nothing Then
				MainPage(1) = Replace(MainPage(1),"{?PurchaseLine}",Purchase.GetPurchaseLink())
			Else
				MainPage(1) = Replace(MainPage(1),"{?PurchaseLine}","")
			End If
		Else
			MainPage(1) = Replace(MainPage(1),"{?PurchaseLine}","")
		End If
		
		If CurrentScript<>"Index" Then
			MainPage(0) = Replace(MainPage(0),"{?AdBottom}",GetImage(3,Config.Settings(41),Config.Settings(42)))
			TempHtml = replace(MainPage(0),"{?TopHtml}",MainPage(1)&MainPage(2)&MainPage(3)&MainPage(4))
			TempHtml = replace(replace(TempHtml,"{?TopSearch}",TopSearch),"{?MenuHtml}",MenuHtml("Nt_ClassName"))
			TempHtml = replace(replace(TempHtml,"{?Menu}",ShowMenu("Nt_ClassName")&replace(MainPage(7),"{?ClassPageSize}",Config.Settings(17))),"{?Announce}",WriteAnnounce())
	
			' 鼠标右键
			If Config.Settings(14) = "1" Then TempHtml = replace(TempHtml,"{?MouseRight}",MainPage(6)) Else TempHtml = replace(TempHtml,"{?MouseRight}","")
	
			' 文章分类
			Cache = "PageIndex"
			If CacheIsEmpty() Then TempToCache("PageIndex")
			PageIndex = Replace(vCache,"{?PicUrl}",CssFilePath)
					
			TempHtml = Replace(TempHtml,"@SiteLogo",GetImage(4,Config.Settings(35),Config.Settings(36)))
			TempHtml = Replace(TempHtml,"@Banner",GetImage(1,Config.Settings(37),Config.Settings(38)))
			TempHtml = Replace(TempHtml,"{?CountStr}",MainPage(8))
		Else
			MainPage(3) = Replace(MainPage(3),"pic_menu","index_art_class")
			MainPage(3) = Replace(MainPage(3),"ClassMenuCell","index_art_class_cell")
			MainPage(3) = Replace(MainPage(3),"ShowClass","ShowArtClass")
		End If
		
		Cache = "Page"&CurrentScript
		if CacheIsEmpty() Then TempToCache("Page"&CurrentScript)
		If CurrentScript = "Comm" Then
			Template.Value = Replace(Replace(vCache,"{?PicUrl}",CssFilePath),"{?SiteName}",Config.SiteName)
		End If
	End Sub
	
	Public Sub TempToCache(MyCacheName)
		Dim crs
		Set crs = Conn.Execute("Select "&MyCacheName&" from [Nt_Style] where IsDefault=1")
		If Not(crs.Eof Or crs.Bof) Then
			vCache = crs(0)&""
		Else
			vCache = ""
		End If
		Set crs = Nothing
	End Sub
	
	Public Function FlashCode(width,height,url)
		Dim Html
		Html = Replace(CommHtml(9),"{?FlashUrl}",url)
		If width = 0 Then
			Html = Replace(Html,"width=""{?Width}""","")
		Else
			Html = Replace(Html,"{?Width}",width)
		End If
		If height = 0 Then
			Html = Replace(Html,"height=""{?Height}""","")
		Else
			Html = Replace(Html,"{?Height}",height)
		End If
		FlashCode = Html
	End Function
	
	Public Function GetHideSql(tableAlias)
		GetHideSql = " and "&tableAlias&"IsHide=0"
		If GetCookie("ViewHide") = "1" Then GetHideSql = ""
	End Function

	Public Function GetImage(adId,intWidth,intHeight)
		Dim ads,ImageCode:ImageCode = ""
		Set ads = Conn.Execute("Select * from Nt_AdImage where AdId="&adId)
		If Not(ads.Eof Or ads.Bof) Then
			If CStr(ads("AdShow"))="1" Then
				If CStr(ads("AdFile")&"")<>"" Then
					If Right(Lcase(ads("AdFile")),3)="swf" Then
						ImageCode = FlashCode(CInt(intWidth),CInt(intHeight),Config.SystemUrl&ads("AdFile"))
					Else
						If CInt(intWidth) = 0 Or CInt(intHeight) = 0 Then
							ImageCode = "<a href='"&ads("AdLink")&"' target='_blank'><img src='"&ads("AdFile")&"' border=0></a>"
						Else
							ImageCode = "<a href='"&ads("AdLink")&"' target='_blank'><img src='"&ads("AdFile")&"' width="&intWidth&" height="&intHeight&" border=0></a>"
						End If
					End If
				End If
			Else
				ImageCode = ads("AdCode")&""
			End If
		End If
		GetImage = ImageCode
	End Function
	
	Public Function GetCode()
		GetCode = "<img src="""&Config.SystemUrl&"Inc/getcode.asp"" align=absmiddle height=18 style=""cursor : pointer;"" onclick=""this.src='"&Config.SystemUrl&"Inc/getcode.asp'"" />"
	End Function
	
	Public Function DataExists(strSql)
		DataExists = (Not Conn.Execute(strSql).Eof)
	End Function
	
	Public Function UserLogin()
		Dim Title,Content,UserGroup,rs,Html,Purview,PurChnArr,PurEngArr,UpLink
		If UserName = "" Then
			UserLogin = replace(CommHtml(3),"{?CheckCode}",GetCode())
		Else
			UserGroup = GetCookie("Group"):Purview="会员等级："&UserGroup
			if GetCookie("Upload")="1" then UpLink="href='Admin_Index.asp'" else UpLink="href='#' onclick=""alert('对不起，您目前没有该权限！');"""
			PurChnArr = Array("浏览图片","浏览隐藏图片","图片评论评分","上传图片","图片是否需要审核","管理自己图片","管理所有图片","查看原图")
			PurEngArr = Array("View","ViewHide","Vote","Upload","PicFlag","Self","Manage","Source")
			For i = 0 to Ubound(PurEngArr)
				Purview = Purview &"<br>"&PurChnArr(i)&"："
				if GetCookie(PurEngArr(i)) = "1" then Purview=Purview&"√" else Purview=Purview&"×"
			Next
			UserLogin = replace(replace(replace(CommHtml(2),"{?UserName}",UserName),"{?Purview}",Purview),"{?UpLink}",UpLink)
		End if
	End Function
	
	Public Function TransUrl(url,times)
		Response.Write("<script language=JavaScript>")
		Response.Write("document.write('正在执行操作，请稍候...');")
		Response.Write("setTimeout(""window.location='"&url&"'"","&times&");")
		Response.Write("</script>")
	End Function
	

	Public Function SpecialList(srcTable)
		Dim srs,html,filename,title
		If srcTable="Nt_Special" Then
			filename="ShowClass.asp"
			title = "<span style='width: 60%'>图片专题</span><a href='Special.asp' class='diary_more'>more...</a>"
		Else
			filename="Diary.asp"
			title = "<span style='width: 60%'>文章专题</span><a href='Special.asp' class='diary_more'>more...</a>"
		End If
		Set srs = Conn.Execute("Select Top 5 * From "&srcTable&" order by RootId,OrderId")
		Do While Not srs.Eof
			html = html&"<img src='Face/"&CssFilePath&"/t_head05.gif' vspace='2' align='absmiddle'> "
			html = html&"<a href='"&filename&"?SpecialID="&srs("ID")&"' target='_blank'>"&srs("SpecialName")&"</a><br>"
			srs.MoveNext
		Loop
		Set srs = Nothing
		SpecialList = Replace(Netout.CommHtml(1),"{?Title}",title)
		SpecialList = Replace(SpecialList,"{?Height}",120)
		SpecialList = Replace(SpecialList,"{?Content}",html)
	End Function
	
	' 组件是否安装
	Public Function ObjectInstalled(strClassString)
		On Error Resume Next
		ObjectInstalled = False
		Err = 0
		Dim xTestObj
		Set xTestObj = Server.CreateObject(strClassString)
		If 0 = Err Then ObjectInstalled = True
		Set xTestObj = Nothing
		Err = 0
	End Function
	
	' 得到目录的大小
	Public Function GetFolderSize(folderName)
		On Error Resume Next
		Dim fso,path,folder
		
		GetFolderSize = 0
		If Trim(folderName&"") = "" Then Exit Function
		path = Server.MapPath(folderName)
		Set fso = Server.CreateObject("Scripting.FileSystemObject")
		If fso.FolderExists(path) Then
			Set folder = fso.GetFolder(path)
			GetFolderSize = folder.Size
			Set folder = Nothing
		End If
		Set fso = Nothing
	End Function
	
	' 取数据库的某列值（字符型）
	Public Function GetScalar(strSql)
		Dim Rs
		Set Rs = Server.CreateObject("adodb.recordset")
		Rs.Open strSql,Conn,1,1
		If Not(Rs.Eof Or Rs.Bof) Then
			GetScalar = Rs(0)&""
		Else
			GetScalar = ""
		End If
		Rs.Close
		Set Rs = Nothing
	End Function
	
	' 取数据库的某列值（数字型）
	Public Function GetNumberScalar(strSql)
		Dim Rs
		GetNumberScalar = 0
		Set Rs = Server.CreateObject("adodb.recordset")
		Rs.Open strSql,Conn,1,1
		If Not(Rs.Eof Or Rs.Bof) Then
			GetNumberScalar = CheckNumeric(Rs(0)&"")
		End If
		Rs.Close
		Set Rs = Nothing
	End Function
	
	' 取指定行数的顶部连接
	Public Function GetTopLink(Rows)
		Dim Rs,TopLink,i
		Set Rs = Conn.Execute("Select Top "&Rows&" LinkName,LinkUrl,target From Nt_TopLink")
		TopLink = Rs.GetRows()
		Set Rs = Nothing
		GetTopLink = ""
		For i = 0 To Ubound(TopLink,2)
			GetTopLink = GetTopLink & "<a href='"&TopLink(1,i)&"' target='"&TopLink(2,i)&"' class='toplink'>"&TopLink(0,i)&"</a> | "
		Next
		If Not Purchase Is Nothing Then
			GetTopLink = GetTopLink & "<a href='pay.asp' class='toplink'>付款方式</a> | "
		End If
	End Function

	' 取最新的文章
	Public Function NewArticle(Rows)
		Dim rs,Html,i:i = 0
		Set rs = Conn.Execute("Select Top "&Rows&" ID,Title from Nt_Diary where Passed=1 order by sTime Desc")
		Set ID = rs(0):Set Title = rs(1)
		Do While Not rs.eof And i<Rows
			Html = Html&"<img src=Face/"&CssFilePath&"/shuy.gif width=18 height=15 align='absmiddle' vspace=4> <a href='Diary.asp?ID="&ID&"' title='"&Title&"'>"&CutStr(Title,20)&"</a><br>"
			rs.MoveNext:i = i+1
		Loop
		Set rs = Nothing
		Set ID = Nothing:Set Title = Nothing
		NewArticle = Replace(CommHtml(1),"{?Height}",Rows*21)
		NewArticle = Replace(Replace(NewArticle,"{?Content}",Html),"{?Title}","最新"&Config.ThemeTitle)
	End Function

	' 热门文章
	Public Function HotPhoto(Rows)
		Dim rs,HotHtml,i:i = 0
		Set rs = Conn.Execute("Select top "&Rows&" titleID,titleName,iClick from Nt_title where Exists(Select * from Nt_ImgBook Where TitleId=Nt_title.TitleId and Passed=1"&GetHideSql("")&") order by iClick Desc")
		Set titleID = rs(0):Set titleName = rs(1):Set iClick = rs(2)
		Do While Not rs.eof And i<Rows
			HotHtml = HotHtml&"<img src=Face/"&CssFilePath&"/t_head05.gif width=18 height=15 align='absmiddle' vspace=4> <a href='Image.asp?titleID="&titleID&"&Pos=0' target=_blank title='"&titleName&"'>"&CutStr(titleName,16)&"["&iClick&"]</a><br>"
			rs.MoveNext:i = i+1
		Loop
		Set rs = Nothing
		Set titleID = Nothing:Set titleName = Nothing:Set iClick = Nothing
		HotPhoto = Replace(CommHtml(1),"{?Height}",Rows*21)
		HotPhoto = Replace(Replace(HotPhoto,"{?Content}",HotHtml),"{?Title}","点击排行")
	End Function
	
	' 友情连接
	Public Function FriendSite(h)
		Dim Content,rsSite,Html,SiteHtml
		i = 0:Html = Split(CommHtml(4),"||")
		Set rsSite = Execute("select top 10 SiteUrl,SiteName,LogoUrl from NT_FriendSite where LogoUrl<>'' and LogoUrl<>'http://'")
		Do While Not rsSite.eof And i<10
			SiteHtml = SiteHtml&Replace(Replace(Replace(Html(2),"{?SiteUrl}",rsSite(0)),"{?SiteName}",rsSite(1)),"{?LogoUrl}",rsSite(2))
			rsSite.movenext:i = i+1
		Loop
		Set rsSite = Nothing
		FriendSite = Replace(CommHtml(1),"{?Title}",Html(0))
		FriendSite = Replace(Replace(FriendSite,"{?Content}",Html(1)),"@LinkList",SiteHtml)
		FriendSite = Replace(Replace(FriendSite,"{?Height}",h),"@LinkLogo",GetImage(5,88,31))
	End Function
	
	' 最新评论
	Public Function NewComment(Rows)
		Dim rs,NewHtml,i:i = 0
		
		Set rs = conn.Execute("Select top "&Rows&" [ID],MarkDesc,MarkTime,titleID,DiaryId,ImageId from Nt_Remark where "&_
			"(DiaryId>0 and exists(select id from Nt_Diary where id=Nt_Remark.DiaryId)) Or "&_
			"(titleId>0 and exists(select titleid from Nt_title where titleid=Nt_Remark.titleID)) Or "&_
			"(ImageId>0 and exists(select id from Nt_ImgBook where id=Nt_Remark.ImageId"&GetHideSql("")&")) "&_
			"order by [MarkTime] Desc")
		If Not(rs.Eof Or rs.bof) Then
			Set ID = rs(0)
			Set MarkDesc = rs(1)
			Set MarkTime = rs(2)
			Do While Not rs.eof And i<Rows
				NewHtml = NewHtml&"<img src=Face/"&CssFilePath&"/t_head05.gif width=18 height=15 align='absmiddle' vspace=4> "
				If CheckNumeric(rs("titleID"))>0 Then
					NewHtml = NewHtml&"<a href='Image.asp?titleID="&rs("titleID")&"#"&ID&"'"
				ElseIf CheckNumeric(rs("DiaryID"))>0 Then
					NewHtml = NewHtml&"<a href='Diary.asp?ID="&rs("DiaryID")&"#"&ID&"'"
				Else
					NewHtml = NewHtml&"<a href='Comment.asp?ID="&rs("ImageId")&"&show=1'"
				End If
				NewHtml = NewHtml&" title='"&MarkDesc&"' style='line-height: 22px;' target='_blank'>"&CutStr(MarkDesc,16)&" "&Month(MarkTime)&"-"&Day(MarkTime)&"</a><br>"
				rs.MoveNext:i = i+1
			Loop
		Else
			NewHtml = "<img src=Face/"&CssFilePath&"/t_head05.gif width=18 height=15 align='absmiddle' vspace=4> 没有任何评论"
		End If
		Set rs = Nothing
		NewComment = replace(replace(CommHtml(1),"{?Height}",Rows*21),"{?Title}","最新评论")
		NewComment = replace(NewComment,"{?Content}",NewHtml)
	End Function
	
	' 当前位置
	Public Function Position()
		Dim Html,ClassID,SpecialID,titleID,ClassName,Init,sFiles,rs
		Dim PosTable,PosText,PosRight,theTable,ChnName,EngName,TName,SName,Photoer
		
		PosTable = Split(CommHtml(6),"||"):Init = False:PosText=""
		ClassID = CheckNumeric(Request.QueryString("ClassID"))
		SpecialID = CheckNumeric(Request.QueryString("SpecialID"))
		If Not IsNumeric(ClassId) Then ClassID = 0
		If Not IsNumeric(SpecialId) Then SpecialId = 0
		
		Show = CheckStr(Request.QueryString("Show"),"S")
		Keyword = CheckStr(Request.QueryString("keyword"),"")
		Photoer = CheckStr(Request.QueryString("Photoer"),"")
		
		IF ClassID>0 Then
			ClassName = "-"&GetLongClassName(ClassID,"-","Nt_ClassName","ShowClass.asp?Show="&Show&"&","_self","position")
		ElseIf SpecialId>0 Then
			Set rs = Conn.Execute("select SpecialName from Nt_Special where id="&SpecialId)
			If Not(rs.Eof or rs.bof) Then
				ClassName = "-<a class='position' href='ShowClass.asp?SpecialID="&SpecialId&"'>"&rs(0)&"</a>"
			End If
			Set rs = Nothing
		End If
		
		IF InStr("showclass.asp,search.asp,person.asp",Config.ScriptUrl) Then
			IF InStr(Config.ScriptUrl,"search.asp") Then
				PosText = "-图片搜索"
				IF Keyword<>"" Then PosText = PosText&"-<a class='position' href='search.asp?keyword="&Keyword&"'>"&Keyword&"</a>"
			ElseIf instr(Config.ScriptUrl,"person.asp") Then 
				PosText = "-"&Photoer&"的作品"
			Else
				IF ClassID>0 Or SpecialID>0 Then PosText = ClassName
			End If
			Init=True
		End IF
		sType = Request.QueryString("Type")
		IF Not Init And InStr(Config.ScriptUrl,"pic.asp")<=0 Then
			ChnName = Array("图片","用户注册","修改资料","关于本站","高级搜索","版权声明","权限申请","会员列表","友情连接","取回密码","购图篮","付款方式/充值","专题")
			EngName = Array("showimage.asp","reg.asp","chginfo.asp","about.asp","search1.asp","help.asp","apppurview.asp","photoers.asp","links.asp","lostpass.asp","basket.asp","pay.asp","special.asp")
			IF Config.ScriptUrl = "showimage.asp" Then
				Html = "-<a class='position' href='"&Config.ScriptUrl&"?Type="&sType&"'>"
			Else
				Html = "-<a class='position' href='"&Config.ScriptUrl&"'>"
			End If
			For i = 0 to Ubound(EngName)
				IF Config.ScriptUrl = EngName(i) Then
					If i=0 Then Html = Html&sType&ChnName(0) Else Html = Html&ChnName(i)
					Exit For
				End If
			Next
			PosText = Html&"</a>"
		End IF
		theTable = Replace(PosTable(0),"{?PosText}",PosText)
		IF InStr(Config.ScriptUrl,"pic.asp") Then
			PosRight = "共有图片 "&Conn.Execute("Select count(*) from Nt_title")(0)&" 组 合计 "&Conn.Execute("Select Count(*) from Nt_ImgBook")(0)&" 张&nbsp;"
			theTable = replace(theTable,"{?PosRight}",PosRight)
		Else
			Dim CurrI:Init = False
			sFiles=Array("showclass.asp","search.asp","showimage.asp","person.asp","showgroup.asp")
			For i=0 to Ubound(sFiles)
				IF Instr(Config.ScriptUrl,sFiles(i)) Then
					CurrI=i:Init=True:Exit For
				End IF
			Next
			IF Init Then
				Select Case CurrI
				Case 0
					TName=Config.ScriptUrl&"?Show=T&ClassID="&ClassID
					SName=Config.ScriptUrl&"?Show=S&ClassID="&ClassID
				Case 1
					Dim theName,FormName:theName=Config.ScriptUrl&"?h=n"
					For Each FormName in Request.QueryString()
						IF InStr("search,submit2,show",Lcase(FormName))=0 Then
							IF Request.QueryString(FormName)<>"" Then theName=theName&"&"&FormName&"="&Request.QueryString(FormName)
						End IF
					Next
					TName=theName&"&Show=T":SName=theName&"&Show=S"
				Case 2
					TName=Config.ScriptUrl&"?Show=T&Type="&sType
					SName=Config.ScriptUrl&"?Show=S&Type="&sType
				Case 3
					TName=Config.ScriptUrl&"?Photoer="&Photoer&"&Show=T"
					SName=Config.ScriptUrl&"?Photoer="&Photoer&"&Show=S"
				Case 4
					titleID = Request.QueryString("titleID")
					TName=Config.ScriptUrl&"?Show=T&titleID="&titleID
					SName=Config.ScriptUrl&"?Show=S&titleID="&titleID
				End Select
				theTable = Replace(Replace(Replace(theTable,"{?PosRight}",PosTable(1)),"{?tname}",TName),"{?sname}",SName)
			Else
				theTable = Replace(theTable,"{?PosRight}","")
			End IF
		End IF
		IF Config.Settings(8) = "0" And InStr("showclass.asp,search.asp,showimage.asp",Config.ScriptUrl) Then
			Position = Replace(theTable,"576","763")
		Else
			Position = theTable
		End IF
	End Function

	' 取当前分类及下级分类Id
	Public Function GetAllClassId(classId,table)
		Dim Rs
		Set Rs = Conn.Execute("Select ID From "&table&" where ParentPath like '%,"&classId&"' Or ParentPath like '%,"&classId&",%'")
		IF Not(Rs.Eof Or Rs.Bof) Then
			GetAllClassId = Rs.GetString(,,,",","")&classId
		Else
			GetAllClassId = classId
		End If
		Set Rs = Nothing
	End Function
	
	Public Function GetLongClassName(classId,prefix,table,href,target,style)
		Dim Rs
		Set Rs = Server.CreateObject("adodb.recordset")
		Rs.Open "Select ParentId,ClassName From "&table&" Where ID="&classId,Conn,1,1
		If Not(Rs.Eof Or Rs.Bof) Then
			GetLongClassName = GetLongClassName(Rs(0),prefix,table,href,target,style)&prefix&"<a class='"&style&"' href='"&href&"ClassID="&classId&"' target='"&target&"'>"&Rs(1)&"</a>"
			If Left(GetLongClassName,1) = prefix Then GetLongClassName = Mid(GetLongClassName,2)
		Else
			GetLongClassName = ""
		End If
		Rs.Close
		Set Rs = Nothing
	End Function
	
	Public Function WriteAnnounce()
		Dim Html,rs
		Set rs = Execute("select top 5 title,AnnounceDesc,id from NT_Announce order by ID desc")
		Do While Not rs.eof
			Html=Html&"<a href='#' onclick=""javascript:window.open('Announce.asp?ID="&rs(2)&"', 'newwindow', 'height=300, width=400, toolbar=no, menubar=no, scrollbars=yes, resizable=yes, location=no, status=no')"" class='more' title="""&rs(1)&""">"&rs(0)&"</a>&nbsp;&nbsp;&nbsp;&nbsp;"
			rs.MoveNext
		Loop
		Set rs = Nothing
		WriteAnnounce="<marquee scrollamount='2' onMouseOut='this.start();' onMouseOver='this.stop();' width='100%'>"&Html&"</marquee>"
	End Function
	
	Public Function ShowPage(totalPut,MaxPerPage,CurrentPage)
		Dim Html,theHtml
		if totalPut mod MaxPerPage=0 then n=totalPut\MaxPerPage Else n=totalPut\MaxPerPage+1
		if CurrentPage>=2 then
			theHtml = theHtml & "<a href='"&strFileName&"page=1'>首页</a>&nbsp;<a href='"&strFileName&"page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
		End If
		if n-currentpage>=1 then
			theHtml = theHtml & "<a href='"&strFileName&"page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;<a href='"&strFileName&"page=" & n & "'>尾页</a>"
		End If
		Html = replace(replace(CommHtml(11),"{?InitText}",InitText),"{?totalPut}",totalPut)
		Html = replace(replace(Html,"{?CurrentPage}",CurrentPage),"{?MaxPerPage}",MaxPerPage)
		Html = replace(replace(replace(Html,"{?upDown}",theHtml),"{?n}",n),"{?strFile}",strFileName)
		If Config.ScriptUrl = "image.asp" Then
			ShowPage = replace(Html,"97%","730")
		ElseIf InStr(Config.ScriptUrl,"article.asp") Then 
			ShowPage = replace(Html,"5 solid","0 solid")
		Else
			IF Config.Settings(8) = "0" And InStr(",showclass.asp,search.asp,showimage.asp,",","&Config.ScriptUrl&",") Then
				IF Config.Settings(11) = "1" Then
					ShowPage = Replace(Html,"97%","740")
				Else
					ShowPage = Replace(Html,"97%","710")
				End IF
			Else
				ShowPage = Html
			End IF
		End If
	End Function
	
	Public Function ShowRecord(CurrentPage)
		dim Html
		set rs=server.CreateObject("adodb.recordset")
		rs.open SqlRecord,conn,1,1
		if rs.eof or rs.bof then
			ShowRecord = "<table align='center' border='0' width='562' cellspacing='0' cellpadding='0'><tr><td align='center' class='f100'><br>"&ErrCode(13)&right(InitText,Len(InitText)-1)&"！</td></tr></table>"
		Else
			totalPut=rs.recordcount
			if (CurrentPage-1)*MaxPerPage>totalput then
				if (totalPut mod MaxPerPage)=0 then
					CurrentPage= totalPut \ MaxPerPage
				Else
					CurrentPage= totalPut \ MaxPerPage + 1
				End If
			End If
			if CurrentPage>1 then
				if (CurrentPage-1)*MaxPerPage<totalPut then
					rs.move  (CurrentPage-1)*MaxPerPage
					dim bookmark
					bookmark=rs.bookmark
				Else
					CurrentPage=1
				End If
			End If
			if TopPage then Html=Html&ShowPage(totalPut,MaxPerPage,CurrentPage)
			Html=Html&ShowContent(MaxPerPage)
			if BottomPage then Html=Html&ShowPage(totalPut,MaxPerPage,CurrentPage)
			ShowRecord = Html
		end if
		rs.close
		set rs=nothing
	End Function
	
	Public Function TrueSize(iWidth,iHeight,MaxWidth,MaxHeight)
		Dim m,n,PreWidth,PreHeight
		m=iWidth/MaxWidth:n=iHeight/MaxHeight
		if iWidth>MaxWidth or iHeight>MaxHeight Then
			If m>=n Then PreWidth=MaxWidth Else PreWidth = Int(iWidth*MaxHeight/iHeight)
		Else
			PreWidth=iWidth
		End If
		TrueSize=" width="&Cint(PreWidth)
	End Function	

	Public Function ShowMenu(TableName)
		Dim sqlRoot,rsRoot,ID,ClassName,RootID,Child,MyHtml,target
		MyHtml = vbCrlf & "<script language=""javascript"">" & vbCrlf & "var "&TableName&" = '"
		sqlRoot="select ID,ClassName,RootID,Child,target From "&TableName&" where ParentID=0 order by RootID,OrderID"
		Set rsRoot = Execute(sqlRoot)
		If rsRoot.bof And rsRoot.eof Then 
			MyHtml = MyHtml & "||0,"&ErrCode(13)&ErrCode(14)
		Else
			Set ID = rsRoot("ID")
			Set ClassName = rsRoot("ClassName")
			Set Child = rsRoot("Child")
			Set RootID = rsRoot("RootID")
			Set target = rsRoot("target")
			Do While Not rsRoot.eof
				MyHtml = MyHtml & "||"
				If Child>0 Then MyHtml = MyHtml & ID & "," & RootID Else MyHtml = MyHtml & ID
				MyHtml = MyHtml & "," & ClassName & "," & target
				rsRoot.movenext
			Loop
		End If
		Set rsRoot = Nothing
		MyHtml = MyHtml & "';" & vbCrlf & "</script>" & vbCrlf
		ShowMenu = MyHtml
	End Function
	
	Public Function MenuHtml(TableName)
		dim sqlMenu,rsMenu,PrevRootID,tmpDepth,i,Html
		Html="<script language='JavaScript' type='text/JavaScript'>" & vbcrlf
		Html=Html&"//菜单列表" & vbcrlf
		dim arrShowLine(20)
		for i=0 to ubound(arrShowLine)
			arrShowLine(i)=False
		next
		sqlMenu="select ID,ClassName,RootID,Child,iDepth,NextID,ClassUrl,target From "&TableName&" where iDepth>=1 order by RootID,OrderID"
		Set rsMenu= Execute(sqlMenu)
		PrevRootID=0
		if not(rsMenu.bof and rsMenu.eof) then
			tmpDepth=rsMenu("iDepth")
			if rsMenu("NextID")>0 then arrShowLine(tmpDepth)=True else arrShowLine(tmpDepth)=False
			If Tablename = "Nt_ClassName" Then
				Html=Html&"var menu" & rsMenu("RootID") & "=" & chr(34)
			Else
				Html=Html&"var menu_T" & rsMenu("RootID") & "=" & chr(34)
			End If
			for i=1 to tmpDepth
				if i=tmpDepth then
					if rsMenu("NextID")>0 then Html=Html&"├&nbsp;" else Html=Html&"└&nbsp;"
				else
					if arrShowLine(i)=True then Html=Html&"│" else Html=Html&"&nbsp;&nbsp;"
				end if
			next
			If TableName = "Nt_ClassName" Then
				Html=Html&"<a target='"&rsMenu("target")&"' href='ShowClass.asp?ClassID="&rsMenu(0)&"'>" & rsMenu(1) & "</a><br>"
			Else
				Html=Html&"<a target='"&rsMenu("target")&"' href='Diary.asp?ClassID="&rsMenu(0)&"'>" & rsMenu(1) & "</a><br>"
			End If
			PrevRootID=rsMenu("RootID")
			rsMenu.movenext
			do while not rsMenu.eof
				if rsMenu("RootID")<>PrevRootID then
					If Tablename = "Nt_ClassName" Then
						Html=Html& chr(34) & ";" & vbcrlf & "var menu" & rsMenu("RootID") & "=" & chr(34)
					Else
						Html=Html& chr(34) & ";" & vbcrlf & "var menu_T" & rsMenu("RootID") & "=" & chr(34)
					End If
				end if
				tmpDepth=rsMenu("iDepth")
				if rsMenu("NextID")>0 then arrShowLine(tmpDepth)=True else arrShowLine(tmpDepth)=False
				for i=1 to tmpDepth
					if i=tmpDepth then
						if rsMenu("NextID")>0 then Html=Html&"├&nbsp;" else Html=Html&"└&nbsp;"
					else
						if arrShowLine(i)=True then Html=Html&"│" else Html=Html&"&nbsp;&nbsp;"
					end if
				next
				If TableName = "Nt_ClassName" Then
					Html=Html&"<a target='"&rsMenu("target")&"' href='ShowClass.asp?ClassID="&rsMenu(0)&"'>" & rsMenu(1) & "</a><br>"
				Else
					Html=Html&"<a target='"&rsMenu("target")&"' href='Diary.asp?ClassID="&rsMenu(0)&"'>" & rsMenu(1) & "</a><br>"
				End If
				PrevRootID=rsMenu("RootID")
				rsMenu.movenext
			loop
			Html=Html& chr(34) & ";" & vbcrlf
		end if
		set rsMenu=nothing
		MenuHtml = Html&"</script>" & vbcrlf
	End Function
	
	Public Function ArtClassOption(SelectName,CurrentId)
		ArtClassOption = ShowClassOption(SelectName,"Nt_ArtClassName",CurrentId,100)
	End Function
	
	Public Function ClassOption(SelectName,CurrentId)
		ClassOption = ShowClassOption(SelectName,"Nt_ClassName",CurrentId,148)
	End Function
	
	Public Function ArtSpecialOption(ShowType,CurrentID,width)
		SpecialOption = ShowSpecial_Options(ShowType,CurrentID,"Nt_ArtSpecial",width)
	End function
	
	Public Function SpecialOption(ShowType,CurrentID,width)
		SpecialOption = SpecialOptions(ShowType,CurrentID,"Nt_Special",width)
	End Function

	Public Function SpecialOptions(ShowType,CurrentID,TableName,width)
		dim rsSpecial,sqlSpecial,Html,tmpDepth,i
		Html = "<span style='width:"&width&"px;height:18px;border: 1 solid #7a7a7a;'>"
		Html = Html&"<select name='"&SelectName&"' style='width:"&width+2&"px;height:20px;font-size: 12px;margin=-2;'>"&vbcrlf

		sqlSpecial="Select ID,SpecialName,NextID From "&TableName&" order by RootID,OrderID"
		Set rsSpecial=conn.execute(sqlSpecial)
		dim arrShowLine(20)
		for i=0 to ubound(arrShowLine)
			arrShowLine(i)=False
		next	
		if rsSpecial.bof and rsSpecial.bof then
			if showType=3 then
				Html = Html&"<option value='0'>请选择所属专题，不选则不属于任何专题</option>"
			else
				Html = Html&"<option value=''>没有专题</option>"
			end if
		else
			if ShowType=1 or ShowType=2 then
				Html = Html&"<option value=''>请选择一个专题</option>"
			elseif showType=3 then
				Html = Html&"<option value='0'>请选择所属专题，不选则不属于任何专题</option>"
			else
				Html = Html&"<option value='' selected>全部专题</option>"
			end if
			do while not rsSpecial.eof
				if rsSpecial(2)>0 then
					arrShowLine(tmpDepth)=True
				else
					arrShowLine(tmpDepth)=False
				end if			
				if ShowType=1 then
					Html = Html&"<option value='" & rsSpecial(1) & "'"
				else
					Html = Html&"<option value='" & rsSpecial(0) & "'"
				end if
				if Trim(rsSpecial(0)&"")=Trim(CurrentID&"") then
					Html = Html&" selected"
				end if
				Html = Html&">"&rsSpecial(1)&"</option>"
				rsSpecial.movenext
			loop
		end if
		SpecialOptions = Html
		rsSpecial.close
		set rsSpecial=nothing
	End Function

	Public Function ShowClassOption(SelectName,TableName,CurrentId,width)
		dim HtmlBegin,HtmlEnd,rsClass,tmpDepth,i,Html
		Html = "<span style='width:"&width&"px;height:18px;border: 1 solid #7a7a7a;'>"
		Html = Html&"<select name='"&SelectName&"' style='width:"&width+2&"px;height:20px;font-size: 12px;margin=-2;'>"&vbcrlf
		set rsClass=Execute("Select * From "&TableName&" where ClassUrl Is Null Or ClassUrl='' order by RootID,OrderID")
		dim arrShowLine(20)
		for i=0 to ubound(arrShowLine)
			arrShowLine(i)=False
		next
		if rsClass.bof and rsClass.bof then
			Html=Html&"<option value=''>没有分类</option>"&vbcrlf
		else
			Html=Html&"<option value=''>全部分类</option>"&vbcrlf
			do while not rsClass.eof
				Html=Html&"<option"&Selected(CurrentId,RsClass("ID"))&">"
				tmpDepth=rsClass("iDepth")
				if rsClass("NextID")>0 then arrShowLine(tmpDepth)=True else arrShowLine(tmpDepth)=False
				if tmpDepth>0 then
					for i=1 to tmpDepth
						Html=Html&"&nbsp;&nbsp;"
						if i=tmpDepth then
							if rsClass("NextID")>0 then Html=Html&"├&nbsp;" else Html=Html&"└&nbsp;"
						else
							if arrShowLine(i)=True then Html=Html&"│" else Html=Html&"&nbsp;&nbsp;"
						end if
					next
				end if
				Html=Html&rsClass("ClassName")
				Html=Html&"</option>"&vbcr
				rsClass.movenext
			loop
		end if
		set rsClass=nothing
		Html = Html&"</select></span>"&vbcr
		ShowClassOption = Html			  
	End Function
	
	Public Function ShowErr(ErrNo)
		ShowErr = replace(CommHtml(10),"{?ErrMsg}",ErrCode(ErrNo))
		If Config.ScriptUrl = "image.asp" Then
			ShowErr = replace(ShowErr,"{?return}","<a href=""javascript:window.close();"">&lt;&lt;关 闭&gt;&gt;</a>")
		Else
			ShowErr = replace(ShowErr,"{?return}","<a href=""javascript:history.back(-1);"">返回上一页</a>")
		End If
		ShowErr = replace(TempHtml,"{?CurrentScript}",ShowErr)
		Response.Write ShowErr
	End Function
	
	Public Function ShowError(ErrMsg)
		Dim tmphtml:tmphtml = CommHtml(10)
		tmphtml = Replace(tmphtml,"{?ErrMsg}",ErrMsg)
		tmphtml = Replace(tmphtml,"{?return}","<a href=""javascript:history.back(-1);"">返回上一页</a>")
		tmphtml = Replace(TempHtml,"{?CurrentScript}",tmphtml)
		Response.Write(tmphtml)
	End Function

	Public Function Execute(Command)
		On Error Resume Next
		Set Execute = Conn.Execute(Command)
	End Function
	Public Sub Write(String)
		Response.Write(String)
	End Sub
	
	Public Sub DelFile(FileName)
		Dim objFso
		Set objFso = Server.CreateObject("Scripting.FileSystemObject")
		If objFso.FileExists(Server.mappath(FileName)) Then
			objFso.DeleteFile Server.mappath(FileName)
		End if
		Set objFso = nothing
	End Sub	

	Public Function chkEmail(email)
		If Trim(email&"") = "" Then
			chkEmail = False
		Else
			chkEmail = CheckRegExp("\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*",email)
		End If
	End Function
	
	Function CheckRegExp(pattern, strings) 
		Dim regEx, Match ' 建立变量。 
		Set regEx = New RegExp ' 建立正则表达式。 
		regEx.Pattern = pattern ' 设置模式。 
		regEx.IgnoreCase = False ' 设置是否区分字符大小写。 
		regEx.Global = True ' 设置全局可用性。 
		
		CheckRegExp = regEx.test(strings) 
	End Function
	
	Public Function CheckNumeric(Byval CHECK_ID)
		If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
			CHECK_ID = cCur(CHECK_ID) _
		Else _
			CHECK_ID = 0
		CheckNumeric = CHECK_ID
	End Function

	Public Function CheckStr(Str,Def)
		If Trim(Str)="" Then CheckStr = Def Else CheckStr = Trim(Str)
	End Function
	
	Public Function ReplaceBadChar(strChar)
		Dim strings
		strings = strChar&""
		if strings="" then
			ReplaceBadChar = ""
		else
			ReplaceBadChar = Replace(Replace(strings,Chr(0),""),"'","''")
			'ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"'",""),"*",""),"?",""),"(",""),")",""),"<",""),".","")
		end if
	End function
	
	Public Function JoinChar(strUrl)
		if strUrl="" then
			JoinChar=""
			exit function
		end if
		if InStr(strUrl,"?")<len(strUrl) then 
			if InStr(strUrl,"?")>1 then
				if InStr(strUrl,"&")<len(strUrl) then 
					JoinChar=strUrl & "&"
				else
					JoinChar=strUrl
				end if
			else
				JoinChar=strUrl & "?"
			end if
		else
			JoinChar=strUrl
		end if
	End Function

	Public Function FormatTime(Strings,format)
		If IsDate(Strings) Then
			Dim Times(6,2)
			Times(1,1) = Year(Strings)
			Times(1,2) = "20"&Right(Times(1,1),2)
			Times(2,1) = Month(Strings)
			Times(2,2) = Right("00"&Times(2,1),2)
			Times(3,1) = Day(Strings)
			Times(3,2) = Right("00"&Times(3,1),2)
			Times(4,1) = Hour(Strings)
			Times(4,2) = Right("00"&Times(4,1),2)
			Times(5,1) = Minute(Strings)
			Times(5,2) = Right("00"&Times(5,1),2)
			Times(6,1) = Second(Strings)
			Times(6,2) = Right("00"&Times(6,1),2)
			
			Strings = Replace(Replace(Ucase(format),"YYYY",Times(1,2)),"YY",Times(1,1))
			Strings = Replace(Replace(Strings,"MM",Times(2,2)),"M",Times(2,1))
			Strings = Replace(Replace(Strings,"DD",Times(3,2)),"D",Times(3,1))
			Strings = Replace(Replace(Strings,"HH",Times(4,2)),"H",Times(4,1))
			Strings = Replace(Replace(Strings,"NN",Times(5,2)),"N",Times(5,1))
			Strings = Replace(Replace(Strings,"SS",Times(6,2)),"S",Times(6,1))
		End If
		
		FormatTime = Strings
	End Function

	Public Function Js_html(Str)
		Js_html = Replace(Replace(Replace(Replace(Replace(Str,vbTab,""),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
	End Function
	
	Public Function SendData(SendTo,Data)
		dim objSend,Str
		on error resume next
		
		SendData = ""
		
		Str="<Netout><![CDATA["&Data&"V200609]]></Netout>"
		set objSend = Server.CreateObject("Microsoft.XMLHTTP")
		objSend.open "POST",Config.SoftInfo(8)&SendTo,false
		objSend.send Str
		if objSend.readystate<>4 then Exit Function
		
		SendData = Bytes2bStr(objSend.ResponseBody)
		
		set objSend=nothing				
	End Function
	
	Function Bytes2bStr(vin)
		Dim BytesStream,StringReturn
		Set BytesStream = Server.CreateObject("ADODB.Stream")
		With BytesStream
			.Type = 2        
			.Open                     
			.WriteText vin            
			.Position = 0             
			.Charset = "GB2312"       
			.Position = 2             
			StringReturn = .ReadText  
			.close                    
		End With
		Set BytesStream = Nothing     
		Bytes2bStr = StringReturn
	End Function
	
	Function cutStr(str,strlen)
		Dim l,t,c,i
		l=Len(str):t=0
		For i=1 to l
			c=Abs(Asc(Mid(str,i,1)))
			If c>255 Then t=t+2 Else t=t+1
			If t>=strlen Then
				cutStr=left(str,i)
				Exit For
			Else
				cutStr=str
			End If
		Next
		cutStr = Replace(cutStr,chr(10),"")
		cutStr = Replace(cutStr,chr(13),"")
	End Function
	
	Public Function strLength(str)
		On Error Resume Next
		Dim WINNT_CHINESE
		WINNT_CHINESE    = (len("中国")=2)
		If WINNT_CHINESE Then
			Dim l,t,c,i
			l=len(str):t=l
			For i=1 to l
				c=asc(mid(str,i,1))
				If c<0 Then c=c+65536
				If c>255 Then t=t+1
			Next
			strLength=t
		Else 
			strLength=Len(str)
		End If
		If Err.Number<>0 Then Err.Clear
	End Function
	
	Public Function CreateName()
		Dim strRanNum,arrDateTime,strNowTime
		
		Randomize
		strRanNum = Int(9999*Rnd)+1000
		strRanNum = String(4-Len(strRanNum),"0")&strRanNum
		strNowTime = Now()
		arrDateTime = Array(Year(strNowTime),Month(strNowTime),Day(strNowTime),Hour(strNowTime),Minute(strNowTime),Second(strNowTime))
		
		CreateName = arrDateTime(0)
		For i = 1 To 5
			CreateName = CreateName & String(2-Len(arrDateTime(i)),"0")&arrDateTime(i)
		Next
	End Function
	
	Public Function HtmlEncode(Str,TOHtml)
		Dim tmpStr:tmpStr = Str&""
		IF tmpStr = "" Then
			HtmlEncode = ""
		Else
			If TOHtml Then
				tmpStr = Replace(tmpStr,"&","&amp;")
				tmpStr = Replace(tmpStr,Chr(34),"&#34;")
				tmpStr = Replace(tmpStr,Chr(39),"&#39;")
				tmpStr = Replace(tmpStr,"<","&lt;")
				tmpStr = Replace(tmpStr,">","&gt;")
				tmpStr = Replace(tmpStr,Chr(13), "")
			Else
				tmpStr = Replace(tmpStr,"&lt;","<")
				tmpStr = Replace(tmpStr,"&gt;",">")
				tmpStr = Replace(tmpStr,"&#39;",Chr(39))
				tmpStr = Replace(tmpStr,"&#34;",Chr(34))
				tmpStr = Replace(tmpStr,"&amp;","&")
			End If
		End IF
		HTMLEncode = tmpStr
	End Function
	
	Public Function HtmlCode(Str,Html)
		IF Html Then
			HtmlCode = HtmlEncode(Str,True)
			HtmlCode = Replace(HtmlCode,Chr(32),"&nbsp;")
			HtmlCode = Replace(HtmlCode,vbCrlf,"<br>")
			HtmlCode = Replace(HtmlCode,Chr(10),"<br>")
			HtmlCode = Replace(HtmlCode,Chr(10)&Chr(10),"<p></p>")
		Else
			HtmlCode = Replace(Str,"<p></p>",Chr(10)&Chr(10))
			HtmlCode = Replace(HtmlCode,"<br>",vbCrlf)
			HtmlCode = Replace(HtmlCode,"&nbsp;",Chr(32))
			HtmlCode = HtmlEncode(HtmlCode,False)
		End IF
	End Function
End Class

Class Netout_Template
	Public Html
	Public Property Let Value(ByVal vNewValue)
		Dim tmpstr:tmpstr = vNewValue
		With Netout
			tmpstr = replace(.CommHtml(0),"{?ClassOption}",.ClassOption("ClassID",0))
			tmpstr = replace(replace(vNewValue,"{?Position}",.Position()),"{?CenterSearch}",tmpstr)
			tmpstr = replace(tmpstr,"{?NewArticle}",.NewArticle(8))
			tmpstr = replace(tmpstr,"{?UserLogin}",.UserLogin())
			tmpstr = replace(replace(tmpstr,"{?HotPhoto}",.HotPhoto(8)),"{?FriendSite}",.FriendSite(20))
			tmpstr = replace(replace(tmpstr,"{?(ClassID)}",.ClassOption("ClassID",0)),"{?(ClassID2)}",.ClassOption("ClassID2",0))
			tmpstr = replace(tmpstr,"{?NewComment}",.NewComment(8))
			tmpstr = replace(tmpstr,"{?SpecialList}",.SpecialList("Nt_Special"))
		End With
		Html = Split(tmpstr,"@@")
	End Property
End Class
%>